          SUBROUTINE (INIT.ID)
** Version# 111.0008[1] - 04/12/2010 - 01:12pm - SMITJR - eclipse
*** V111.0007 Change - Custom Coding . - 04/12/2010 - WINFEL - eclipse
*** V111.0006 Change - Custom Coding CUSTOM - 04/12/2010 - SMITJR - eclipse
*** V111.0005 Change - Custom Coding . - 04/11/2010 - WINFEL - eclipse
*** V111.0003 Change - Custom Coding . - 04/11/2010 - WINFEL - eclipse
*** V111.0002 Change - Custom Coding . - 04/11/2010 - SMITJR - eclipse
** Copied from BP PROCURE.EDIT Version# 111 - 09/26/2009 - 05:03pm - CASEY - main

*** SUBROUTINE - PROCURE.EDIT
*-------------------------------------------------------------------------*
*** This routine is design to 'run' the Procurement Confirmation screen,
*** F6-Q-M. This screen displays all procurement sources for the branch
*** that was specified by the User.
*-------------------------------------------------------------------------*
*** INIT.ID  - Inital ID - Includes Order ID, Gen, LDID, SKIPLOCK    (IN)
*-------------------------------------------------------------------------*
*** COMMON VARIABLES:
***       None Specified
*-------------------------------------------------------------------------*
          *** Check auth. key to see if this user should be view only.
          VIEW.ONLY = NO
          CHECK.KEY "PROCUREMENT.CONFIRM",ENTRY.OK,PROCURE.LEVEL
          IF NOT(ENTRY.OK) THEN RETURN
          IF PROCURE.LEVEL < 2 THEN VIEW.ONLY = YES

          *** Check control record to see if we need to check the customer
          *** credit before allowing the products to be added to an exiting
          *** purchase order to before allowing a purchase order to be
          *** created for the products.
          READ CHK.CRED FROM CTRLFILE,'CK.CUS.CREDIT.PROC' ELSE
             CHK.CRED = ''
          END
          *** Value one is for po's
          CHK.CRED = CHK.CRED<1,1>

          SCREEN
BEGINQ:
          VSCROLL.DEFINE 1,1,3,78,15
          VSCROLL.SET 1

          QSIGN     = -1
          BUYER.ID  = USER.ID
          ADDLS     = ''
          READV SORT.OPT FROM CTRLFILE,'DFLT.PO.PROCURE.SORT',1 ELSE
             SORT.OPT = 1
          END

          SORT.SELS = 'Customer':VM:'Ship Via':VM:'Buy Line'
          LOCATE(SORT.OPT,SORT.SELS,1;SORT.OPT) ELSE
             SORT.OPT = 1
          END

          PRT.ITEMS = 'All':VM:'Printed':VM:'Unprinted'

          RANGE.FLAG = NO
          RANGE.START.LINE = ''
          RANGE.END.LINE = ''
          RANGE.VENS = ''

          *** Determine if we need to copy over SO COGS to PO Cost
          READ COPY.COST FROM CTRLFILE,'COPY.PROCURE.COST' ELSE
             COPY.COST = 'N'
          END

          GOSUB LOAD.HOTKEYS
          IF INIT.ID#'' THEN
             CONVERT ',' TO AM IN INIT.ID
             OID  = INIT.ID<1>
             GEN  = INIT.ID<2>
             LDID = INIT.ID<3>
             SKIPLOCK = INIT.ID<4>
             MATREAD LED FROM LEDFILE,OID ELSE GOTO FINISH
             BR    = LED(2)<1,GEN,2>
             BRCHS = BR
             PO.BR = BR
             SEL.OID = OID
             PRT.SEL = 'All'
             GOTO RESTART
          END ELSE
             SEL.OID  = ''
             SKIPLOCK = NO
          END
          PRINT @(68,1):BUYER.ID  "L#10"

*-------------------------------------------------------------------------*
IN.BR:    *** Input Branch
IN$$1:    INP.BR 11,1,10,BR,NAME,BRCHS,YES
          IF QUIT THEN GOTO FINISH
          IF BR = '' THEN PRINT BELL:; GOTO IN.BR
          PO.BR = BRCHS<1,1>
          ON MOVE+1 GOTO IN.BR,IN.BR,IN.BR,IN.BR,IN.SEL,IN.SEL
*-------------------------------------------------------------------------*
IN.SEL:   *** Input Select Items option (All, Printed, Unprinted)
IN$$3:    INP PRT.SEL,45,1,10,V_'D:':PRT.ITEMS
          IF QUIT THEN GOTO BEGINQ
          IF PRT.SEL='' THEN GOTO IN.SEL
          ON MOVE GOTO IN.BR,IN.SEL,IN.SEL,IN.SEL
*-------------------------------------------------------------------------*
IN.BID:   *** Input Buyer Id
IN$$8:    INP BUYER.ID,68,1,10,V_'S:VERF.USER.ID'
          IF QUIT THEN GOTO BEGINQ
          ON MOVE+1 GOTO IN.BID,IN.SEL,IN.BID,IN.BID
*-------------------------------------------------------------------------*
RESTART:  PRINT @(11,1):BR         "L#10"
          PRINT @(45,1):PRT.SEL    "L#10"
          PRINT @(68,1):BUYER.ID   "L#10"
          GOSUB SEL.IDS

          LN.CT = DCOUNT(TABLE.DATA,AM)
          IF LN.CT = 0 THEN
             MESS 20,10,BELL:'No Items Found'
             PRINT @(61,18):' 0 of ':LN.CT:' '
             GOTO IN.BR
          END

          IF VIEW.ONLY THEN
             PRINT @(2,0):BLINK$:'View Only':NORM$
          END

          COL = 1; LINE = 1; COLS = 1; DNOK = YES; MOVE = 0; LASTKEY=0
*-------------------------------------------------------------------------*
MOVENEXT: IF QUIT THEN IF INIT.ID THEN GOTO FINISH ELSE GOTO BEGINQ
          LN.CT = DCOUNT(TABLE.DATA,AM)
          IF LN.CT=0 THEN IF INIT.ID THEN GOTO FINISH ELSE GOTO BEGINQ
          IF LINE > LN.CT THEN LINE = LN.CT
          PARSEMOVE COL,LINE,COLS,LN.CT,15,DNOK
          PRINT @(61,18):' ':LINE:' of ':LN.CT:' '
*-------------------------------------------------------------------------*
IN.VEN:   *** Input Vendor
          PQ.ID    = TABLE.DATA<LINE,2,4>
          READ PREC FROM PROCQFILE,PQ.ID ELSE PREC = ''

          * Restrict entry in view only
          IF VIEW.ONLY THEN LGTH = 0 ELSE LGTH = 21
          ORIG.VEN = FIELD(PQ.ID,'~',3)
IN.VEN2:  INPV VEN,53,LINE,LGTH
          IF CHANGED THEN
             VERF.VEN.SF.NODEL 53,LINE,LGTH,VEN,BRCHS,ORIG.VEN
             IF VEN = '' THEN
                CN = FIELD(TABLE.DATA<LINE,2,4>,'~',3)
                READV NAME FROM CUSFILE,CN,1 ELSE NAME = ''
                VPRINT 53,LINE,NAME "L#21"
                GOTO IN.VEN
             END ELSE
                READV NAME FROM CUSFILE,VEN,1 ELSE NAME = ''
                LINE.DATA<8,1> = VEN
                LINE.DATA<8,2> = NAME

                * Save data when user changes name.
                TMP = LINE.DATA<8,1>:SVM:LINE.DATA<8,2>
                TABLE.DATA<LINE,1,8> = LOWER(TMP)
             END

             PQ.ID    = TABLE.DATA<LINE,2,4>
             OID      = FIELD(PQ.ID,'~',1)
             LDID     = FIELD(PQ.ID,'~',2)
             OLD.SRC  = 'P~':FIELD(PQ.ID,'~',3)
             NEW.SRC  = 'P~':VEN

             IF NEW.SRC # OLD.SRC THEN
                CHECK.RECORD.LOCK LEDFILE,OID,IS.LOCKED,USER.LOCKED
                IF IS.LOCKED AND NOT(SKIPLOCK) THEN
                   MSG = 'This change will not take affect until the'
                   MSG<-1> = 'order is unlocked.'
                   MESS 2,10,BELL:MSG
                END

                READ PREC FROM PROCQFILE,PQ.ID ELSE PREC = ''
                FROM.LOT = (PREC<6> = 1)
                NEW.ID = OID:'~':LDID:'~':VEN
                TABLE.DATA<LINE,2,4> = NEW.ID

                PROC.CHNG.SOURCE OID,LDID,OLD.SRC,NEW.SRC,SKIPLOCK
                IF FROM.LOT THEN
                   READVU TEST FROM PROCQFILE,NEW.ID,6 THEN
                      WRITEV FROM.LOT ON PROCQFILE,NEW.ID,6
                   END
                   RELEASE PROCQFILE,NEW.ID
                END
             END
             VPRINT 53,LINE,NAME "L#21"
          END

          GOTO MOVENEXT
*-------------------------------------------------------------------------*
SEL.IDS:  LOCATE PRT.SEL IN PRT.ITEMS<1> SETTING SEL.OPT ELSE SEL.OPT=1
          * Select IDS
          QUEUE.SELECT.PCQ SELECTED.IDS
          * Filter IDS
          SEL.DATA = ''
          SEL.DATA<1> = BRCHS
          SEL.DATA<2> = PRT.SEL
          SEL.DATA<3> = BUYER.ID
          SEL.DATA<4> = SEL.OID
          SEL.DATA<5> = SORT.OPT

          ETERM.SEARCH.ITEMS 'QUEUE.FILTER.PCQ',SEL.DATA,SELECTED.IDS,FILTERED.IDS
          * Sort IDS
          QUEUE.SORT.PCQ FILTERED.IDS,SEL.DATA,TABLE.DATA
          * Build List of Branches
          TOTAL.LINES = DCOUNT(TABLE.DATA,AM)
          RBRS = ''
          FOR XX = 1 TO TOTAL.LINES
             RBRS<1,XX> = TABLE.DATA<XX,1,3>
          NEXT XX
          GOSUB REDISP.ALL.LNS
          RETURN
*-------------------------------------------------------------------------*
DISP.LNS:
          FOR LN = START.ROW TO ROW.CT
             VINS LN
             LINE.DATA = RAISE(RAISE(TABLE.DATA<LN,1>))
             LN.FLAG = LINE.DATA<7,1>
             VEN     = LINE.DATA<8,1>
             IF RANGE.FLAG THEN
                IF LN >= RANGE.START.LINE AND LN <= RANGE.END.LINE THEN
                   * If user changed vendor after select and new vendor
                   * was not included in selected range, deselect it
                   LOCATE VEN IN RANGE.VENS SETTING NADA THEN LN.FLAG = '*'
                END
             END
             PRD.DESC = LINE.DATA<7,2>
             BRX      = LINE.DATA<3>
             OID      = LINE.DATA<4>
             PROC.QTY = LINE.DATA<5>
             SHIP.VIA = LINE.DATA<9>
             UM.PER   = LINE.DATA<6>
             VEN.NAME = LINE.DATA<8,2>
             VPRINT 0,LN,BRX             "L#4"              ;* the branch
             VPRINT 5,LN,OID             "L#10"             ;* the OID
             VPRINT 16,LN,PROC.QTY       "R#7":UM.PER"L#2"
             VPRINT 26,LN,LN.FLAG        "L#1"
             VPRINT 28,LN,PRD.DESC       "L#24"
             VPRINT 53,LN,VEN.NAME[1,21] "L#21"
             VPRINT 75,LN,SHIP.VIA       "L#3"
          NEXT XX
          RETURN
*-------------------------------------------------------------------------*
REDISP.LN:*** Redisplay Line
          VDEL LINE
          START.ROW = LINE
          ROW.CT = LINE
          GOSUB DISP.LNS
          * If the Item posittion has moved down the list due to sort,
          * everything else shifts ups so we dont need to move the cursor
          IF LINE < LN THEN LINE -= 1      ;* Current Item Moved Down List
          RETURN
*-------------------------------------------------------------------------*
REDISP.ALL.LNS:*** Redisplay All Lines
          VCLR 1

          START.ROW = 1
          ROW.CT = DCOUNT(TABLE.DATA,AM)
          GOSUB DISP.LNS
          RETURN
*-------------------------------------------------------------------------*
SUBS:     IF TABLE.DATA='' THEN
             MESS 10,10,BELL:'Items must be Selected First'
             RETURN
          END

          ON OPTION GOTO VIEW.EDIT, VIEW.EDIT, CREATE.PO, CREATE.PO, PRINTIT, HOLDIT,SORT,RANGE,DESELECT
*-------------------------------------------------------------------------*
SORT:     *** Select Sort Option
          VAR = ''
          ROWS = DCOUNT(SORT.SELS,VM)
          MENU.TABLE VAR,20,10,1,ROWS,20,,,SORT.SELS,'Sort Options',SORT.OPT
          IF VAR = '' THEN SORT.OPT = 1
          LOCATE VAR IN SORT.SELS<1> SETTING SORT.OPT ELSE SORT.OPT = 1

          RETURN TO RESTART
*-------------------------------------------------------------------------*
RANGE:    *** Allow selection of a range of items

          RANGE.VENS = ''
          RANGE.FLAG = YES
          RANGE.START.LINE = LINE

          MESS 3,1,BELL:'Arrow up/down to last line of desired range and hit <return> to select.'

          MOVE = 0; QUIT = 0; LASTKEY = 0
          DONE = NO
          LOOP UNTIL DONE DO
IN$$6:       INPV A,53,LINE,1
             IF QUIT THEN
                RANGE.FLAG = NO
                DONE = YES
             END ELSE
                PARSEMOVE COL,LINE,COLS,LN.CT,15,DNOK,1
                IF RANGE.FLAG AND MOVE = 5 THEN
                   GOSUB LOAD.HOTKEYS
                   RANGE.END.LINE = LINE - 1
                   IF RANGE.END.LINE < RANGE.START.LINE THEN
                      SV.R = RANGE.END.LINE
                      RANGE.END.LINE = RANGE.START.LINE
                      RANGE.START.LINE = SV.R
                   END
                   FOR X = RANGE.START.LINE TO RANGE.END.LINE
                      LINE = X
                      RANGE.VENS<-1> = FIELD(TABLE.DATA<LINE,2,4>,'~',3)
                      GOSUB REDISP.LN
                   NEXT X
                   LINE = RANGE.END.LINE
                   GOSUB REDISP.LN
                   DONE = YES
                END
             END
          REPEAT

          RETURN
*-------------------------------------------------------------------------*
DESELECT: *** Deselect list
          RANGE.FLAG = NO
          RANGE.START.LINE = ''
          RANGE.END.LINE = ''
          GOSUB CLEAR.RANGE

          RETURN
*-------------------------------------------------------------------------*
VIEW.EDIT:*** View/Edit the order
          ID        = TABLE.DATA<LINE,2,4>
          OID       = FIELD(ID,'~',1)
          MODE      = OID[1,1]
          INIT.VIEW = 1
          INIT.OID  = OID
          LDID      = FIELD(ID,'~',2)
          V.ONLY    = YES

          IF OPTION = 2 THEN V.ONLY = NO

          MATREAD LED FROM LEDFILE,OID ELSE MAT LED = ''

          OE.NEXT.SHIPDATE INIT.GEN
          IF INIT.GEN+0=0 THEN INIT.GEN = 1

          * Places the cursor on the same item in the order that the
          * cursor was on when the hot key was invoked
          LD.GETV THIS.PN,LDID,1
          INIT.GEN<1,2> = THIS.PN

          VIEW.EDIT.LED INIT.OID,INIT.GEN,V.ONLY,INIT.VIEW

          RETURN
*-------------------------------------------------------------------------*
CREATE.PO:*** Create Purchase Order
          * If this is 'Add to PO' and the Procurement Confirmation auth
          * key does not allow this, beep and return
          IF OPTION = 4 AND PROCURE.LEVEL = 2 THEN
             PRINT BELL:
             RETURN
          END

          IF RANGE.FLAG THEN
             TMP.LINE = RANGE.START.LINE
FIND.ID:     PQ.ID = TABLE.DATA<TMP.LINE,2,4>
             SOURCE = FIELD(PQ.ID,'~',3)
             * Make sure this ID is still selected in case Vendor
             * was changed to be outside of the range vendors.
             LOCATE SOURCE IN RANGE.VENS SETTING POS ELSE
                TMP.LINE += 1
                IF TMP.LINE <= RANGE.END.LINE THEN GOTO FIND.ID ELSE
                   RETURN
                END
             END
             IF OPTION # 4 THEN
                GOSUB GET.VENDOR
                IF SOURCE = '' THEN
                   GOSUB CLEAR.RANGE
                   RETURN
                END
             END
          END ELSE
             PQ.ID  = TABLE.DATA<LINE,2,4>
             SOURCE = FIELD(PQ.ID,'~',3)
          END

          READ PREC FROM PROCQFILE,PQ.ID ELSE
             PREC = ''
             MSG  = 'Procurement ID for ':FIELD(PQ.ID,'~',1)
             MSG := ' has been changed.':AM
             MSG := 'Cannot update.'
             MESS 2,10,BELL:MSG
             RETURN
          END
          * Don't let update occur if record is locked to another process
          CHECK.RECORD.LOCK LEDFILE,FIELD(PQ.ID,'~',1),IS.LOCKED,USER.LOCKED
          IF IS.LOCKED AND NOT(SKIPLOCK) THEN
             MSG  = 'Procurement ID for ':FIELD(PQ.ID,'~',1)
             MSG := ' is locked by ':USER.LOCKED:AM
             MSG := 'Cannot update.'
             MESS 2,10,BELL:MSG
             RETURN
          END

          * Get the VendorID, from which the SO should be procured from
          ST.CN = SOURCE

          * Check to see whether the Vendor has a separate PayTo Vendor
          READV BT.CN FROM CUSFILE,ST.CN,11 ELSE BT.CN = ''
          IF BT.CN = '' THEN BT.CN = ST.CN

          * Do the no order entry flag check
          IF RANGE.FLAG THEN
             GET.CUS TABLE.DATA<RANGE.START.LINE,1,3>,BT.CN,ST.CN,1 ;* PO, qsign is 1
          END ELSE
             GET.CUS TABLE.DATA<LINE,1,3>,BT.CN,ST.CN,1 ;* PO, qsign is 1
          END

          IF CUSS(23)<1,5> THEN
             MESS 10,10,"Vendor is flagged for no P/O Entry"
             RETURN
          END

          * If there is a different PayTo vendor, we need to flag it
          IF BT.CN#ST.CN THEN DIFF.PAYTO = YES ELSE DIFF.PAYTO = NO

          ADD.TO   = NO
          SRC.OID  = ''
          SRC.GEN  = ''
          TSVIA    = PREC<5>

          IF OPTION=4 THEN
             ADD.TO = YES
             GOSUB GET.OID
             GOSUB CLEAR.RANGE
             IF SRC.OID = '' THEN RETURN
          END

          CT = 0
          FOR J = 1 TO LN.CT
             IF FIELD(TABLE.DATA<J,2,4>,'~',3)=SOURCE THEN
                CT += 1
                IF CT > 1 THEN EXIT
             END
          NEXT J

          CT2 = 0
          TOID = FIELD(TABLE.DATA<LINE,2,4>,'~',1)
          FOR I = 1 TO LN.CT
             NOID = FIELD(TABLE.DATA<I,2,4>,'~',1)
             VEND = FIELD(TABLE.DATA<I,2,4>,'~',3)
             IF NOID=TOID AND VEND=SOURCE THEN
                CT2 += 1
             END
          NEXT I

          IF NOT(RANGE.FLAG) THEN
             COMBINE.ALL = 'Y'
             IF CT > 1 THEN
IN.CMBN:        INP.PROMPT COMBINE.ALL,'Combine all items for vendor : ','YN',1
                IF F12  THEN RETURN
                IF QUIT THEN GOTO IN.CMBN
             END

             COMBINE.VIAS = 'Y'
             IF CT > 1 AND COMBINE.ALL THEN
                IF PREC<5> # '' THEN
INVIA:             INP.PROMPT COMBINE.VIAS,'Combine all items and use ':TSVIA:' as the ship via? ','YN',1
                END

                IF NOT(COMBINE.VIAS) THEN RETURN TO MOVENEXT
                IF F12 THEN RETURN
                IF QUIT THEN GOTO IN.CMBN
             END

             COMBINE.OID = 'Y'
             IF CT2 > 1 AND NOT(COMBINE.ALL) THEN
IN$$4:          INP.PROMPT COMBINE.OID,'Combine all items for order ':TOID:' : ','YN',1
                COMBINE.VIAS = 'Y'
                IF CT > 1 AND COMBINE.ALL THEN
                   IF PREC<5> # '' THEN
INVIA2:                INP.PROMPT COMBINE.VIAS,'Combine all items and use ':TSVIA:' as the ship via? ','YN',1
                   END
                END
                IF NOT(COMBINE.VIAS) THEN RETURN TO MOVENEXT
                IF F12 THEN RETURN
                IF QUIT THEN GOTO IN.CMBN
             END
          END

          WINDOW ,,40,6,3
          TAG.LIST = ''
          PNS      = ''
          QTYS     = ''
          COMMENTS = ''
          TYPES    = ''
          LOCAS    = ''
          CSTS     = ''
          SVCSTS   = ''
          IC       = 0
          REC.BRS  = ''
          SHIP.DATE = ''
          QTY.DIFFS = ''

          READ PCMNT FROM CTRLFILE,'PROCURE.COMMENT' ELSE PCMNT = ""
          READ COPY.COMMENT FROM CTRBFILE,'COPY.PROC.COMMENT~':PO.BR ELSE
             COPY.COMMENT = NO
          END

          BEGIN CASE
          CASE RANGE.FLAG
             FOR J  = RANGE.START.LINE TO RANGE.END.LINE
                ID  = TABLE.DATA<J,2,4>
                BR  = TABLE.DATA<J,1,3>
                * Only add to PO if this ID is still in selected range.
                * If vendor was changed after range selected and it
                * outside of selected range vendors.
                VEN = FIELD(ID,'~',3)
                LOCATE VEN IN RANGE.VENS SETTING POS ELSE CONTINUE
                IF CHK.CRED THEN
                   GOSUB CHK.CREDIT
                   IF CREDIT.OK THEN GOSUB ADD.ITEM
                END ELSE
                   GOSUB ADD.ITEM
                END
             NEXT J
          CASE COMBINE.ALL
             FOR J = 1 TO LN.CT
                ID = TABLE.DATA<J,2,4>
                BR = TABLE.DATA<J,1,3>
                IF FIELD(ID,'~',3) = SOURCE THEN
                   IF CHK.CRED THEN
                      GOSUB CHK.CREDIT
                      IF CREDIT.OK THEN GOSUB ADD.ITEM
                   END ELSE
                      GOSUB ADD.ITEM
                   END
                END
             NEXT J
          CASE COMBINE.OID
             FOR I = 1 TO LN.CT
                ID = TABLE.DATA<I,2,4>
                BR = TABLE.DATA<I,1,3>
                IF FIELD(ID,'~',1)=TOID AND FIELD(ID,'~',3)=SOURCE THEN
                   IF CHK.CRED THEN
                      GOSUB CHK.CREDIT
                      IF CREDIT.OK THEN GOSUB ADD.ITEM
                   END ELSE
                      GOSUB ADD.ITEM
                   END
                END
             NEXT I
          CASE OTHERWISE
             ID = TABLE.DATA<LINE,2,4>
             BR = TABLE.DATA<LINE,1,3>
             IF CHK.CRED THEN
                GOSUB CHK.CREDIT
                IF CREDIT.OK THEN GOSUB ADD.ITEM
             END ELSE
                GOSUB ADD.ITEM
             END
          END CASE

          IF PNS = '' THEN GOTO ABORT.CREATE

          * If copy method is prompt then we need to prompt user if and
          * only if there is either a manual cost override or a sell
          * matrix cost override
          COPY.OVR.COST    = NO
          IF COPY.COST AND CSTS # '' THEN
             COPY.OVR.COST = YES
             IF COPY.COST  = 'P' THEN GOSUB CHK.COPY.COST
          END

          MODE   = 'P'
          STATUS = 'O'
          IF SHIP.DATE < DATE() THEN SHIP.DATE = DATE()
          PRICE.DATE = DATE()
          PN.LDIDS  = ''
          BR.CT = DCOUNT(REC.BRS<1>,VM)
          FOR BRN = 1 TO BR.CT
             RBR    = REC.BRS<1,BRN>
             LOCATE RBR IN RBRS<1> SETTING BR.ID ELSE NULL
             CMTS   = RAISE(COMMENTS<1,BR.ID>)
             * Does not copy procure comments over to a PO.
             IF PCMNT # "" AND CMTS # '' AND NOT(COPY.COMMENT) THEN
               CNT = DCOUNT(CMTS,SVM)
               FOR X = 1 TO CNT
                  CMTS.TMP = ''
                  CMTS.TMP = OCONV(RAISE(CMTS<1,1,X>),'MCU')
                  IF CMTS.TMP<1,1,1> = PCMNT THEN
                     CMTS = DELETE(CMTS,1,1,X)
                  END
               NEXT X
             END

             NPNS   = RAISE(PNS<1,BR.ID>)
             NQTYS  = RAISE(QTYS<1,BR.ID>)
             TYPS   = RAISE(TYPES<1,BR.ID>)
             LOCS   = RAISE(LOCAS<1,BR.ID>)
             PN.LDS = RAISE(PN.LDIDS<1,BR.ID>)
             COSTS  = RAISE(CSTS<1,BR.ID>)
             SVCSTS = RAISE(SVCSTS<1,BR.ID>)
             NQTY.DIFFS = RAISE(QTY.DIFFS<1,BR.ID>)

             IF NOT(COPY.OVR.COST) THEN
                COSTS = ''
                SVCSTS = ''
             END

             IF ADD.TO THEN PBR = RBR:VM:1 ELSE PBR = RBR
             OE.CREATE.LEDGER MODE,ADD.TO,SRC.OID,SRC.GEN,PBR,BT.CN,ST.CN,STATUS,SHIP.DATE,PRICE.DATE,NPNS,NQTYS,CMTS,TYPS,LOCS,PN.LDS,,RBR,,,,CREATE.ERR,,,ADDLS,,SVCSTS,COSTS,,,,,,,,,,,,,,,,NQTY.DIFFS
             IF NOT(ADD.TO) THEN ADD.TO = YES
             IF CREATE.ERR THEN
                MSG = 'Error Occurred During PO Creation'
                UT.GET.PROMPT "%103",PRESS.ENTER
                ERR.MESS 1,1,BELL:MSG:AM:PRESS.ENTER,YES
                GOTO ABORT.CREATE
             END
             RBR    = REC.BRS<1,BRN>
             LOCATE RBR IN RBRS<1> SETTING BR.ID ELSE NULL
             TAG.CT = DCOUNT(TAG.LIST<1,BR.ID>,SVM)
             FOR J = 1 TO TAG.CT
                IF PN.LDS<1,J>#'' THEN
                   PQ.ID    = TAG.LIST<1,BR.ID,J>
                   OID      = FIELD(PQ.ID,'~',1)
                   LDID     = FIELD(PQ.ID,'~',2)
                   OLD.SRC  = 'P~':FIELD(PQ.ID,'~',3)
                   NEW.SRC  = 'T~^':SRC.OID:'.':PN.LDS<1,J>
                   PROC.CHNG.SOURCE OID,LDID,OLD.SRC,NEW.SRC
                   DELETE PROCQFILE,PQ.ID
                END
             NEXT J
          NEXT BRN

          * Put Ship Via on purchase order/transfer
          LED(70)<1,SRC.GEN> = TSVIA

          UPDATE.LEDGER SRC.OID,SRC.GEN
          OE.UNLOCK.LED SRC.OID

          INIT.VIEW = "STOCK.RECEIPTS"
          INIT.OID  = SRC.OID
          INIT.GEN  = SRC.GEN
          V.ONLY    = NO
          OE MODE, INIT.VIEW, INIT.OID, INIT.GEN, V.ONLY
          QUIT = NO

ABORT.CREATE:

          WINDOW.CLOSE
          GOSUB CHECK.ALL

          IF LN.CT OR RANGE.FLAG THEN
             VCLR 1
             GOSUB CLEAR.RANGE
             RETURN
          END ELSE
             RETURN TO FINISH
          END
*-------------------------------------------------------------------------*
CHK.CREDIT:*** Check if customer is on credit hold.

          CREDIT.OK = NO

          OID = FIELD(ID,'~',1)
          MATREAD LED FROM LEDFILE,OID ELSE RETURN
          LDID = FIELD(ID,'~',2)
          LD.GET LDID
          FINDSTR 'P~':FIELD(ID,'~',3) IN LD(7) SETTING XX,GEN ELSE RETURN

          PROCURE.EDIT.CREDIT.CHK 'P',OID,GEN,BR,QSIGN,CREDIT.OK

          RETURN
*-------------------------------------------------------------------------*
ADD.ITEM: *** Add item to a PO
          * If CHK.CRED is set, then the ledger was already read in when
          * we were verifying the customer's credit.  If not, we need to
          * read it in here.
          IF NOT(CHK.CRED) THEN
             OID = FIELD(ID,'~',1)
             MATREAD LED FROM LEDFILE,OID ELSE RETURN
          END

          READ PREC FROM PROCQFILE,ID ELSE
             PREC   = ''
             MSG    = 'Procurement ID for ':FIELD(ID,'~',1)
             MSG<2> = 'has been changed. Cannot update.'
             UT.GET.PROMPT "%103",PRESS.ENTER
             ERR.MESS 1,1,BELL:MSG:AM:PRESS.ENTER,YES
             RETURN
          END

          PRINT @(0,1):BLINK$:'Creating PO ......'  "L#35":NORM$

          OID  = FIELD(ID,'~',1)
          LDID = FIELD(ID,'~',2)
          LD.GET LDID

          PN       = LD(1)    ;* Part Number
          CMT.TYP  = LD(2)    ;* Comment types
          COMMENT  = LD(3)    ;* Comments
          OVR.COST = LD(11)   ;* COGS override
          COST     = LD(10)   ;* COGS value
          MTX.COST = LD(29)   ;* Sell Matrix Overrides
          QTY.DIFF = LD(113)  ;* Qty diff to order
                               * (diff between procure qty & buy pkg qty)
          KEY.KIT  = LD(122)  ;* Backorder kit comp ldids

          QTY = PREC<1> + QTY.DIFF
          IF QTY#0 AND NUM(PN) AND PN#'' THEN
             * Find procurement id in product types to set gen
             FINDSTR 'P~':FIELD(ID,'~',3) IN LD(7) SETTING XX,GNX ELSE
                MSG    = 'Cannot locate generation for'
                MSG<2> = 'Procurement ID ':FIELD(ID,'~',1)
                MSG<3> = 'Cannot update.'
                UT.GET.PROMPT "%103",PRESS.ENTER
                ERR.MESS 1,1,BELL:MSG:AM:PRESS.ENTER,YES
                RETURN
             END

             LOCATE BR IN RBRS<1> SETTING BR.INDEX ELSE NULL
             TPOS = DCOUNT(TAG.LIST<1,BR.INDEX>,SVM)+1
             TAG.LIST<1,BR.INDEX,TPOS>  = ID
             PNS<1,BR.INDEX,TPOS>       = PN
             QTYS<1,BR.INDEX,TPOS>      = PREC<1>
             QTY.DIFFS<1,BR.INDEX,TPOS> = QTY.DIFF

             BEGIN CASE
             CASE COPY.COST = 'B' OR COPY.COST = 'P'
                * If set to "B" for both or "P" for prompt then we want
                * to copy over any override (manual or matrix); manual
                * takes precedence
                * If user then needs to be prompted, we clear out CSTS
                * and SVCSTS if they answer no to copy
                BEGIN CASE
                CASE OVR.COST<1,GNX> # ''
                   CSTS<1,BR.INDEX,TPOS>   = COST<1,GNX> + 0
                   SVCSTS<1,BR.INDEX,TPOS> = 1
                CASE MTX.COST<1,GNX,1>
                   CSTS<1,BR.INDEX,TPOS>   = COST<1,GNX> + 0
                   SVCSTS<1,BR.INDEX,TPOS> = 1
                END CASE
             CASE COPY.COST = 'M' AND OVR.COST<1,GNX> # ''
                *** Copy manual cost overrides
                CSTS<1,BR.INDEX,TPOS>      = COST<1,GNX> + 0
                SVCSTS<1,BR.INDEX,TPOS>    = 1
             CASE COPY.COST = 'X' AND MTX.COST<1,GNX,1> ;*
                * Copy sell matrix cost overrides
                * We need to make sure there is no manual override as
                * well because we only want matrix cost override.  If
                * manual override, set po cost to LD(11)
                IF OVR.COST<1,GNX> # '' THEN
                   CSTS<1,BR.INDEX,TPOS>   = OVR.COST<1,GNX> + 0
                   SVCSTS<1,BR.INDEX,TPOS> = 1
                END ELSE
                   CSTS<1,BR.INDEX,TPOS>   = COST<1,GNX> + 0
                   SVCSTS<1,BR.INDEX,TPOS> = 1
                END
             END CASE

             LOCATE BR IN REC.BRS<1> BY 'AR' SETTING POS ELSE
                REC.BRS = INSERT(REC.BRS,1,POS;BR)
             END

             READV LED2 FROM LEDFILE,OID,2 ELSE LED2 = BR
             SHP.BR = LED2<1,GNX,2>

             IF COMMENT # '' THEN
                READ NCMT FROM CTRBFILE,'NONSTOCK.COMMENT~':SHP.BR ELSE
                   NCMT = ''
                END
                NONSTOCK.COMMENTS.API NCMT,SHP.BR
                NCMT  = OCONV(NCMT,'MCU')
                PCMNT = OCONV(PCMNT,'MCU')

                * Comments are now VM'd by comment type, and SVM'd by
                *  comment line...  Need to loop through both VM's and
                *  SVM's.
                ORIG.CMTS = COMMENT
                IF KEY.KIT THEN
                   READ BO.CMT FROM CTRLFILE,'BO.PARTIAL.KIT.COMMENT' ELSE
                      BO.CMT = ''
                   END
                   IF BO.CMT # '' THEN BO.CMT = TRIM(BO.CMT)
                   ORIG.CMTS<1,-1> = BO.CMT
                   LOCATE BO.CMT IN ORIG.CMTS SETTING CPOS ELSE CPOS = 1
                   CMT.TYP<1,CPOS> = '1'
                END
                COMMENT = ''
                CMT.IX  = 0
                CMT.CT = DCOUNT(ORIG.CMTS,VM)
                FOR CX = 1 TO CMT.CT
                   TYPE.CMTS = CMT.TYP<1,CX>
                   IF NOT(TYPE.CMTS) THEN TYPE.CMTS = 1
                   CSV.CT = DCOUNT(ORIG.CMTS<1,CX>,SVM)
                   FOR CXX = 1 TO CSV.CT

                      CMT = TRIM(OCONV(ORIG.CMTS<1,CX,CXX>,'MCU'))
                      *** Remove non-stock comment.
                      IF NCMT = CMT                       THEN CONTINUE
                      IF NOT(COPY.COMMENT) THEN
                         IF PCMNT = CMT                   THEN CONTINUE
                      END
                      * Remove cust specific pn's & loc's.
                      IF CMT[1,6] = 'YOUR #'              THEN CONTINUE
                      IF CMT[1,13]= 'YOUR LOCATION'       THEN CONTINUE

                      TEMP.CMT = ORIG.CMTS<1,CX,CXX>:SVM:TYPE.CMTS
                      CMT.IX += 1
                      COMMENT<1,1,CMT.IX> = LOWER(TEMP.CMT)
                   NEXT CXX
                NEXT CX

                * OE.CREATE.LEDGER has been modified to handle comment
                * lines one value-level lower than the pn values...
                * Comments gets RAISE'd once before it goes to OE.CREATE.
                * LEDGER, so lower it here by one value-level.
                COMMENTS<1,BR.INDEX,TPOS> = LOWER(COMMENT)
             END
             SHP.DT = PREC<2>+0
             IF SHP.DT AND (SHP.DT < SHIP.DATE OR SHIP.DATE='') THEN SHIP.DATE = SHP.DT
             TYPES<1,BR.INDEX,TPOS> = 'T'
             LOCAS<1,BR.INDEX,TPOS> = '^':OID:'.':LDID
          END
          RETURN
*-------------------------------------------------------------------------*
CHECK.ALL:FOR J = LN.CT TO 1 STEP -1
             ID = TABLE.DATA<J,2,4>
             READ TST FROM PROCQFILE,ID ELSE
                VDEL J
                TABLE.DATA = DELETE(TABLE.DATA,J)
             END
          NEXT J
          LN.CT = DCOUNT(TABLE.DATA,AM)
          IF LINE > LN.CT THEN LINE = LN.CT
          RETURN
*-------------------------------------------------------------------------*
GET.OID:  READV PO.IDS FROM ENTDFILE,BT.CN,1 ELSE PO.IDS = ''
          BR = TABLE.DATA<LINE,1,3>
          CT = DCOUNT(PO.IDS,VM)

          FOR J  = CT TO 1 STEP -1
             DEL.IT = NO

             OID = FIELD(PO.IDS<1,J>,'.',1)
             GID = FIELD(PO.IDS<1,J>,'.',2)+0
             IF OID[1,1]#'P' THEN DEL.IT = YES

             READV GIDS FROM LEDFILE,OID,12 ELSE GIDS = ''
             LOCATE GID IN GIDS<1> SETTING GNX ELSE DEL.IT = YES
             READV BRS FROM LEDFILE,OID,2 ELSE BRS  = ''

             * Make sure the PO is shipping to the same Branch that we
             * need the item being procured to ship to.
             IF BRS<1,GNX,2>#BR THEN DEL.IT = YES

             * If the vendor being procured from is a ShipFrom only then
             * we want to only get Open POs that have that same ShipFrom
             * vendor.
             IF DIFF.PAYTO THEN
                READV SF FROM LEDFILE,OID,5 ELSE SF = ''
                IF SF<1,GNX>#ST.CN THEN DEL.IT = YES
             END

             IF DEL.IT THEN PO.IDS = DELETE(PO.IDS,1,J)
          NEXT J
          MENU.TABLE ORN,1,3,1,8,78,'CALL LED.SELECT.CONV',1,PO.IDS,'P/O #Ord DateOrder IDShip From'
          SRC.OID = FIELD(ORN,'.',1)
          GID = FIELD(ORN,'.',2)+0
          READV LED12 FROM LEDFILE,SRC.OID,12 ELSE LED12 = ''
          LOCATE GID IN LED12<1> SETTING SRC.GEN ELSE SRC.OID = ''
          DIFF.PAYTO = NO
          RETURN
*-------------------------------------------------------------------------*
PRINTIT:  LOC = LOCATION
          GOSUB PRINT.IT
          RETURN
*-------------------------------------------------------------------------*
HOLDIT:   LOC = 'HOLD'
          GOSUB PRINT.IT
          RETURN
*-------------------------------------------------------------------------*
PRINT.IT: *** Print Report
          TITLE    = 'Procured Items : ':OCONV(DATE(),'D2/')
          HDR      = 'Procured Items for Branch : ':BR:'  ':OCONV(DATE(),'D2/'):'              Page : ^#####'
          HDR<1,3> = 'Br   Order #    Shp Date Quantity   Description                    Procure From'
          HDR<1,4> = '---- ---------- -------- ---------- ------------------------------ -------------------------'
          PRINTER.ON 90,TITLE,DOC.ID,HDR
          FOR LN = 1 TO LN.CT
             ID   = TABLE.DATA<LN,2,4>
             OID  = FIELD(ID,'~',1)
             LDID = FIELD(ID,'~',2)
             CN   = FIELD(ID,'~',3)
             READ PREC FROM PROCQFILE,ID ELSE CONTINUE
             READV BRS FROM LEDFILE,OID,2 ELSE BRS = ''
             LD.READV TYPS, OID, LDID, 7
             FINDSTR 'P~':CN IN TYPS SETTING XX,GNX ELSE GNX = 1
             BR.X     = BRS<1,GNX,2>
             SHP.DATE = PREC<2>+0
             LD.READV PN, OID, LDID, 1
             READV DESC  FROM PRDFILE,PN,1  ELSE DESC = ''
             CONVERT VM TO ' ' IN DESC
             READV PROCF FROM CUSFILE,CN,1  ELSE PROCF = ''
             CONVERT VM TO ' ' IN PROCF
             READV PLINE   FROM PRDFILE,PN,9     ELSE PLINE = ''
             READV UM.TBL  FROM PLNEFILE,PLINE,3 ELSE UM.TBL = ''
             READV UMQ.TBL FROM PRDFILE,PN,7     ELSE UMQ.TBL = ''
             LD.READV UM.PER, OID, LDID, 23
             IQ.TO.ALPHA.ONE UM.TBL,UMQ.TBL,UM.PER,PREC<1>,Q1,UM.PER,UM.QTY,BAL,NO
             PRINT BR.X                  "L#4":' ':
             PRINT OID                   "L#10":' ':
             PRINT OCONV(SHP.DATE,'D2/') "L#8":' ':
             PRINT PREC<1>/UM.QTY        "R#8":UM.PER"L#2":' ':
             PRINT DESC                  "L#30":' ':
             PRINT PROCF                 "L#25"
             WRITEV DATE() ON PROCQFILE,ID,4
          NEXT LN
          PRINTER.OFF DOC.ID,LOC
          RETURN
*-------------------------------------------------------------------------*
CHK.COPY.COST:*** Input copy over ride cost

          COPY.OVR.COST = 'N'
          MSG = 'Copy Overridden Cost(s) to P/O: '
IN$$5:    INP.PROMPT COPY.OVR.COST,MSG,'YN',1

          RETURN
*-------------------------------------------------------------------------*
GET.VENDOR:*** Get vendor

          WINDOW ,,60,3
          GOT.VEND = NO
          LOOP UNTIL GOT.VEND DO
             READV VNAME FROM CUSFILE,SOURCE,1 ELSE
                VNAME = ''
             END
             MSG = 'Procure from: ':VNAME
             PRINT @(5,1):MSG
             VEN = SOURCE
IN$$7:       INP VEN,19,1,30
             IF QUIT THEN
                GOT.VEND = YES
                SOURCE = ''
             END ELSE
                IF CHANGED THEN
                   FINDID VN,VEN,'VENDOR','TENTITY;X;9;9',20,7,5,35,'SEL.ENT.ABR','&INDEX&.SF',BRCHS
                   SOURCE = VN
                END ELSE
                   GOT.VEND = YES
                END
                VEN = SOURCE
             END
          REPEAT
          WINDOW.CLOSE

          RETURN
*-------------------------------------------------------------------------*
LOAD.HOTKEYS:*** Load Hot Keys

          MENU.CLEAR
          MENU.LOAD 2,19, 4,1,'V'
          IF NOT(VIEW.ONLY) THEN
             MENU.LOAD  9,19, 4,1,'E'
             MENU.LOAD 16,19, 9,1,'C'
             MENU.LOAD 28,19, 9,1,'A'
          END ELSE
             MENU.LOAD ,,,,
             MENU.LOAD ,,,,
             MENU.LOAD ,,,,
          END
          MENU.LOAD 40,19, 5,1,'P'
          MENU.LOAD 48,19, 4,1,'H'
          MENU.LOAD 55,19, 4,1,'S'
          IF NOT(VIEW.ONLY) THEN
             IF NOT(RANGE.FLAG) THEN
                MENU.LOAD 62,19, 5,1,'R'
                MENU.LOAD ,,,,
             END ELSE
                MENU.LOAD ,,,,
                MENU.LOAD 70,19,8,1,'D'
             END
          END
          RETURN
*-------------------------------------------------------------------------*
CLEAR.RANGE:*** Clear Selected Range

          RANGE.FLAG = NO
          GOSUB REDISP.ALL.LNS
          LN.CT = DCOUNT(TABLE.DATA,AM)
          PRINT @(61,18):' ':LINE:' of ':LN.CT:' '

          GOSUB LOAD.HOTKEYS

          RETURN
*-------------------------------------------------------------------------*
FINISH:   WINDOW.CLOSE
          RETURN
*-------------------------------------------------------------------------*
!SMITJR~04/12/10~13:12

